home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok11 / r.o.m. / m2sources / stringinout.mod < prev    next >
Text File  |  1993-11-04  |  12KB  |  394 lines
  1. IMPLEMENTATION MODULE StringInOut;
  2. (*
  3.   Created: 10.11.1987
  4.   Changed: 18.1.88/07.02.88/29.02.88/25.7.88/11.9.88/10.10.88 by
  5.              Stefan Salewski
  6.              Stolper Weg 3
  7.              2160 Stade   West-Germany
  8.              Tel: 04141/61130
  9.   Note: compiled with AMIGA Modula-2 System by AMSoft Version from 5.5.88
  10.    
  11.   This Module may be freely copied. But please
  12.   leave my name in. Thanks....Stefan
  13. *)
  14.   FROM SYSTEM IMPORT ADR,LONGSET,REG;
  15.   FROM Arts IMPORT Assert;
  16.   FROM MyUties IMPORT Min;
  17.   FROM DeactivateGadget IMPORT PressRButton;
  18.   FROM Intuition IMPORT NewWindow,WindowPtr,Gadget,StringInfo,IntuiText,
  19.     WindowFlags,WindowFlagSet,IDCMPFlags,IDCMPFlagSet,OpenWindow,CloseWindow,
  20.     PrintIText,GadgetFlagSet,ActivationFlags,ActivationFlagSet,
  21.     ScreenFlags,ScreenFlagSet,strGadget,IntuiMessagePtr,
  22.     AddGadget,ActivateGadget,RemoveGadget,RefreshGadgets,ModifyIDCMP;
  23.   FROM Exec IMPORT GetMsg,ReplyMsg,WaitPort,CopyMem,UByte;
  24.   FROM Graphics IMPORT ScrollRaster,RectFill,SetAPen,jam1;
  25.   FROM Preference IMPORT CharSize;
  26.   FROM Strings IMPORT Length;
  27.   FROM Storage IMPORT ALLOCATE,DEALLOCATE;
  28.   CONST BufferLength=255;
  29.   TYPE
  30.     String=ARRAY[0..79] OF CHAR;
  31.     WindowDates=RECORD
  32.                   spalte:INTEGER;
  33.                   zeile:INTEGER;
  34.                   bg,inC,outC:INTEGER;
  35.                   clearIn:BOOLEAN;
  36.                   offSet:INTEGER;
  37.                 END;
  38.     WindowDatesPtr=POINTER TO WindowDates;
  39.     WindowTitle=ARRAY[0..70] OF CHAR;
  40.     WindowTitlePtr=POINTER TO WindowTitle;
  41.   VAR
  42.     charHeight,charWidth:INTEGER;
  43.   
  44.   PROCEDURE ClearWindow(wP:WindowPtr);
  45.     VAR oldAPen:CARDINAL;
  46.       wDatesPtr:WindowDatesPtr;
  47.   BEGIN
  48.     Assert(wP#NIL,ADR('StringInOut:Cannot Clear Window'));
  49.     wDatesPtr:=WindowDatesPtr(wP^.userData);
  50.     oldAPen:=wP^.rPort^.fgPen;
  51.     SetAPen(wP^.rPort,wDatesPtr^.bg);
  52.     RectFill(wP^.rPort,0,0,wP^.width,wP^.height);
  53.     SetAPen(wP^.rPort,oldAPen);
  54.     wDatesPtr^.zeile:=1;
  55.     wDatesPtr^.offSet:=0;
  56.   END ClearWindow;
  57.   
  58.   PROCEDURE SetClear(wP:WindowPtr;clearInput:BOOLEAN);
  59.   VAR wDatesPtr:WindowDatesPtr;
  60.   BEGIN
  61.     Assert(wP#NIL,ADR('StringInOut:Cannot SetClear'));
  62.     wDatesPtr:=WindowDatesPtr(wP^.userData);
  63.     wDatesPtr^.clearIn:=clearInput
  64.   END SetClear;
  65.       
  66.   PROCEDURE SetColors(wP:WindowPtr;background,input,output:INTEGER);
  67.     VAR wDatesPtr:WindowDatesPtr;
  68.   BEGIN
  69.     Assert(wP#NIL,ADR('StringInOut:Cannot SetColors'));
  70.     wDatesPtr:=WindowDatesPtr(wP^.userData);
  71.     wDatesPtr^.bg:=ABS(background MOD 4);
  72.     wDatesPtr^.inC:=ABS(input MOD 4);
  73.     wDatesPtr^.outC:=ABS(output MOD 4);
  74.   END SetColors;
  75.   
  76.   PROCEDURE SetPos(wP:WindowPtr;x,y:INTEGER);
  77.     VAR wDatesPtr:WindowDatesPtr;
  78.   BEGIN
  79.     Assert(wP#NIL,ADR('StringInOut:Cannot SetPos'));
  80.     wDatesPtr:=WindowDatesPtr(wP^.userData);
  81.     x:=ABS(x MOD 80);
  82.     y:=ABS((y-1) MOD 32)+1;
  83.     IF (x+1)*charWidth <= wP^.gzzWidth THEN
  84.       wDatesPtr^.spalte:=x
  85.     ELSE 
  86.       wDatesPtr^.spalte:=(wP^.gzzWidth DIV charWidth)-1;
  87.     END;
  88.     IF y*charHeight<=wP^.gzzHeight THEN
  89.       wDatesPtr^.zeile:=y
  90.     ELSE
  91.       wDatesPtr^.zeile:=wP^.gzzHeight DIV charHeight
  92.     END;
  93.     wDatesPtr^.offSet:=0
  94.   END SetPos;
  95.   
  96.   PROCEDURE GetPos(wP:WindowPtr;VAR x,y:INTEGER);
  97.     VAR wDatesPtr:WindowDatesPtr;
  98.   BEGIN
  99.     Assert(wP#NIL,ADR('StringInOut:Cannot GetPos'));
  100.     wDatesPtr:=WindowDatesPtr(wP^.userData);
  101.     x:=wDatesPtr^.spalte+wDatesPtr^.offSet;
  102.     y:=wDatesPtr^.zeile;
  103.   END GetPos;
  104.         
  105.   PROCEDURE Scrollup(wP:WindowPtr;x:INTEGER);
  106.     VAR oldAPen:CARDINAL;
  107.       wDatesPtr:WindowDatesPtr;
  108.   BEGIN
  109.     Assert(wP#NIL,ADR('StringInOut:Cannot Scroll Window'));
  110.     ScrollRaster(wP^.rPort,0,x,0,0,wP^.width,wP^.height);
  111.     wDatesPtr:=WindowDatesPtr(wP^.userData);
  112.     oldAPen:=wP^.rPort^.fgPen;
  113.     SetAPen(wP^.rPort,wDatesPtr^.bg);
  114.     RectFill(wP^.rPort,0,wP^.gzzHeight-x,wP^.width,wP^.height);
  115.     SetAPen(wP^.rPort,oldAPen);
  116.   END Scrollup;
  117.   
  118.   PROCEDURE WriteString(wP:WindowPtr;s:ARRAY OF CHAR;newLine:BOOLEAN);
  119.     VAR iText:IntuiText;
  120.       wDatesPtr:WindowDatesPtr;
  121.       xx:INTEGER;
  122.   BEGIN
  123.     Assert(wP#NIL,ADR('StringInOut:Cannot WriteString'));
  124.     wDatesPtr:=WindowDatesPtr(wP^.userData);
  125.     xx:=wDatesPtr^.spalte+wDatesPtr^.offSet;
  126.     WITH iText DO
  127.       frontPen:=wDatesPtr^.outC;
  128.       backPen:=wDatesPtr^.bg;
  129.       drawMode:=jam1;
  130.       leftEdge:=0;
  131.       topEdge:=0;
  132.       iTextFont:=NIL;
  133.       iText:=ADR(s);
  134.       nextText:=NIL;
  135.     END;
  136.     IF (wDatesPtr^.zeile*charHeight <= wP^.gzzHeight) THEN
  137.       PrintIText(wP^.rPort,ADR(iText),xx*charWidth,charHeight*
  138.                  (wDatesPtr^.zeile-1));
  139.       INC(wDatesPtr^.zeile);
  140.     ELSE
  141.       Scrollup(wP,charHeight);
  142.       PrintIText(wP^.rPort,ADR(iText),xx*charWidth,
  143.                  charHeight*(wDatesPtr^.zeile-2));
  144.     END;
  145.     IF newLine THEN
  146.       wDatesPtr^.offSet:=0
  147.     ELSE
  148.       DEC(wDatesPtr^.zeile);
  149.       wDatesPtr^.offSet:=wDatesPtr^.offSet+Length(s);
  150.       IF (wDatesPtr^.offSet+wDatesPtr^.spalte+1)*charWidth> wP^.gzzWidth THEN
  151.         wDatesPtr^.offSet:=(wP^.gzzWidth DIV charWidth)-wDatesPtr^.spalte-1;
  152.       END;
  153.     END;
  154.   END WriteString;
  155.   
  156.   PROCEDURE GetKey(wP:WindowPtr):CHAR;
  157.     VAR msg:IntuiMessagePtr;
  158.       newIDCMPFlagSet,oldIDCMPFlagSet:IDCMPFlagSet;
  159.       msgcode:CARDINAL;
  160.   BEGIN
  161.     Assert(wP#NIL,ADR('StringInOut:Cannot Get Key'));
  162.     oldIDCMPFlagSet:=wP^.idcmpFlags;
  163.     newIDCMPFlagSet:=wP^.idcmpFlags-IDCMPFlagSet{rawKey};
  164.     newIDCMPFlagSet:=newIDCMPFlagSet+IDCMPFlagSet{vanillaKey};
  165.     ModifyIDCMP(wP,newIDCMPFlagSet);
  166.     msgcode:=0;
  167.     WaitPort(wP^.userPort);
  168.     msg:=IntuiMessagePtr(REG(0));
  169.     IF vanillaKey IN msg^.class THEN
  170.     (*IF wP^.messageKey^.class= IDCMPFlagSet{vanillaKey} THEN
  171.       Reg(0) ist sicherer
  172.     *)
  173.       inputOK:=TRUE;
  174.       msg:=GetMsg(wP^.userPort);
  175.       msgcode:=msg^.code;
  176.       ReplyMsg(msg)
  177.     ELSE
  178.       inputOK:=FALSE
  179.     END;
  180.     ModifyIDCMP(wP,oldIDCMPFlagSet);      
  181.     RETURN CHAR(msgcode);
  182.   END GetKey;  
  183.     
  184.   PROCEDURE ReadString(wP:WindowPtr;text:ARRAY OF CHAR;
  185.                        VAR str:ARRAY OF CHAR;sichtbareZeichen:StrGadgetLaenge);
  186.     VAR position:INTEGER;
  187.       ok,fine:BOOLEAN;
  188.       msg:IntuiMessagePtr;
  189.       oldIDCMPFlagSet:IDCMPFlagSet;
  190.       wDatesPtr:WindowDatesPtr;
  191.       stringGadget:Gadget;
  192.       myStringInfo:StringInfo;
  193.       myUndoBuffer,myBuffer:ARRAY[0..BufferLength] OF CHAR;
  194.       strGaIText:IntuiText;
  195.       xx:INTEGER;
  196.       oldAPen:CARDINAL;
  197.   BEGIN
  198.     Assert(wP#NIL,ADR('StringInOut:Cannot ReadString'));
  199.     wDatesPtr:=WindowDatesPtr(wP^.userData);
  200.     xx:=wDatesPtr^.spalte+wDatesPtr^.offSet;
  201.     IF (xx+INTEGER(sichtbareZeichen))*charWidth>wP^.gzzWidth THEN
  202.       sichtbareZeichen:= wP^.gzzWidth DIV charWidth;
  203.     END;  
  204.     IF wDatesPtr^.clearIn THEN str[0]:=0C END;
  205.     IF (wDatesPtr^.zeile*charHeight <= wP^.gzzHeight) THEN
  206.       INC(wDatesPtr^.zeile);
  207.     ELSE
  208.       Scrollup(wP,charHeight);
  209.     END;   
  210.     WITH stringGadget DO
  211.       nextGadget:=NIL;
  212.       IF (charWidth*(Length(text)+xx+INTEGER(sichtbareZeichen)))<=
  213.         wP^.gzzWidth THEN
  214.         leftEdge:=(charWidth*(Length(text)+xx))
  215.       ELSE
  216.         leftEdge:=wP^.gzzWidth-INTEGER(sichtbareZeichen)*charWidth
  217.       END;
  218.       topEdge:=(wDatesPtr^.zeile-2)*charHeight;
  219.       width:=INTEGER(sichtbareZeichen)*charWidth;
  220.       height:=charHeight;
  221.       flags:=GadgetFlagSet{};
  222.       activation:=ActivationFlagSet{relVerify};
  223.       gadgetType:=strGadget;
  224.       gadgetRender:=NIL;
  225.       selectRender:=NIL;
  226.       gadgetText:=ADR(strGaIText);
  227.       mutualExclude:=LONGSET{};
  228.       specialInfo:=ADR(myStringInfo);
  229.       gadgetID:=1;
  230.       userData:=NIL;
  231.     END;
  232.     WITH myStringInfo DO
  233.       buffer:=ADR(str);
  234.       undoBuffer:=ADR(myUndoBuffer);
  235.       bufferPos:=0;
  236.       IF HIGH(str) < 255 THEN
  237.         maxChars:=HIGH(str)+1
  238.       ELSE maxChars:=255
  239.       END;
  240.       dispPos:=0;
  241.     END;          
  242.     WITH strGaIText DO
  243.       frontPen:=wDatesPtr^.inC;
  244.       backPen:=wDatesPtr^.bg;
  245.       drawMode:=jam1;
  246.       leftEdge:=-charWidth*Length(text);
  247.       topEdge:=0;
  248.       iTextFont:=NIL;
  249.       iText:=ADR(text);
  250.       nextText:=NIL;
  251.     END;
  252.     oldIDCMPFlagSet:=wP^.idcmpFlags;
  253.     ModifyIDCMP(wP,wP^.idcmpFlags + IDCMPFlagSet{gadgetUp});
  254.     position:=AddGadget(wP,ADR(stringGadget),-1);
  255.     RefreshGadgets(ADR(stringGadget),wP,NIL);
  256.     ok:=ActivateGadget(ADR(stringGadget),wP,NIL);
  257.     WaitPort(wP^.userPort);
  258.     msg:=IntuiMessagePtr(REG(0));
  259.     IF gadgetUp IN msg^.class THEN
  260.     (* IF (wP^.messageKey^.class = IDCMPFlagSet{gadgetUp}) THEN
  261.       Reg(0) ist sicherer *)
  262.       msg:=GetMsg(wP^.userPort);
  263.       ReplyMsg(msg);
  264.       inputOK:=TRUE;
  265.     ELSE
  266.       inputOK:=FALSE;
  267.     END;
  268.     IF NOT inputOK THEN
  269.       ModifyIDCMP(wP,IDCMPFlagSet{closeWindow});
  270.       (* Damit PressRButton keine Message an mein Fenster schickt;
  271.          IDCMPFlagSet{} wuerde den MsgPort schliessen, daher closeWindow
  272.       *)
  273.       IF PressRButton() THEN END;
  274.       oldAPen:=wP^.rPort^.fgPen;
  275.       SetAPen(wP^.rPort,wDatesPtr^.bg);
  276.       RectFill(wP^.rPort,0,stringGadget.topEdge,wP^.width,
  277.                stringGadget.topEdge+charHeight-1);
  278.       SetAPen(wP^.rPort,oldAPen);
  279.       DEC(wDatesPtr^.zeile);
  280.     END;
  281.     position:=RemoveGadget(wP,ADR(stringGadget));
  282.     ModifyIDCMP(wP,oldIDCMPFlagSet);
  283.     wDatesPtr^.offSet:=0;
  284.   END ReadString;
  285.   
  286.   PROCEDURE DeleteChar(wP:WindowPtr;chars:INTEGER);
  287.     VAR
  288.       oldAPen:CARDINAL;
  289.       x1,x2:INTEGER;
  290.       wDatesPtr:WindowDatesPtr;
  291.   BEGIN
  292.     Assert(wP#NIL,ADR('StringInOut:Cannot DeleteChar'));
  293.     wDatesPtr:=WindowDatesPtr(wP^.userData);
  294.     x1:=wDatesPtr^.spalte+wDatesPtr^.offSet;
  295.     x2:=Min((x1+chars)*charWidth,wP^.gzzWidth);
  296.     x1:=Min(x1*charWidth,wP^.gzzWidth);
  297.     oldAPen:=wP^.rPort^.fgPen;
  298.     SetAPen(wP^.rPort,wDatesPtr^.bg);
  299.     RectFill(wP^.rPort,x1,charHeight*(wDatesPtr^.zeile-1),
  300.              x2,charHeight*wDatesPtr^.zeile-1);
  301.     SetAPen(wP^.rPort,oldAPen);
  302.   END DeleteChar;
  303.   
  304.   PROCEDURE OpenNewWindow(VAR wP:WindowPtr;x,y,w,h:INTEGER;wFlags:FlagSet;
  305.                           titel:ARRAY OF CHAR);
  306.     CONST
  307.       BLeft=4;
  308.       BRight=4;
  309.       BBottom=2;
  310.     VAR newWindow:NewWindow;
  311.       wDPtr:WindowDatesPtr;
  312.       wTPtr:WindowTitlePtr;
  313.       help:WindowTitle;
  314.       bTop:[-1..12];
  315.   BEGIN
  316.     IF wFlags=FlagSet{} THEN
  317.       bTop:=2
  318.     ELSE
  319.       bTop:=charHeight+3
  320.     END;
  321.     ALLOCATE(wTPtr,Length(titel));
  322.     CopyMem(ADR(titel),wTPtr,Length(titel));
  323.     ALLOCATE(wDPtr,SIZE(WindowDates));
  324.     WITH wDPtr^ DO
  325.       spalte:=0;
  326.       zeile:=1;
  327.       bg:=2;
  328.       inC:=3;
  329.       outC:=3;
  330.       clearIn:=TRUE;
  331.       offSet:=0;
  332.     END;
  333.     x:=ABS(x MOD 640);
  334.     y:=ABS(y MOD 256);
  335.     w:=w*charWidth+BLeft+BRight;
  336.     w:=ABS(w MOD 640);
  337.     w:=Min(w,639-x);
  338.     h:=h*charHeight+bTop+BBottom;
  339.     h:=ABS(h MOD 255);
  340.     h:=Min(h,255-y);
  341.     WITH newWindow DO
  342.       leftEdge:=x;
  343.       topEdge:=y;
  344.       width:=w;
  345.       height:=h;
  346.       detailPen:=0;
  347.       blockPen:=1;
  348.       idcmpFlags:=IDCMPFlagSet{};
  349.       flags:=WindowFlagSet{activate,gimmeZeroZero,noCareRefresh};
  350.       IF close IN wFlags THEN
  351.         flags:=flags+WindowFlagSet{windowClose};
  352.         idcmpFlags:=IDCMPFlagSet{closeWindow}; 
  353.       END;
  354.       IF drag IN wFlags THEN
  355.         flags:=flags+WindowFlagSet{windowDrag}
  356.       END;
  357.       IF depth IN wFlags THEN
  358.         flags:=flags+WindowFlagSet{windowDepth}
  359.       END;
  360.       type:=ScreenFlagSet{wbenchScreen};
  361.       firstGadget:=NIL;
  362.       checkMark:=NIL;
  363.       IF wFlags=FlagSet{} THEN
  364.         title:=NIL
  365.       ELSE
  366.         title:=wTPtr
  367.       END;
  368.       screen:=NIL;
  369.       bitMap:=NIL;
  370.       minWidth:=w;
  371.       minHeight:=h;
  372.       maxWidth:=w;
  373.       maxHeight:=h;
  374.     END;
  375.     wP:=OpenWindow(newWindow);
  376.     Assert(wP#NIL,ADR('StringInOut:Cannot open Window'));
  377.     IF wP#NIL THEN
  378.       wP^.userData:=wDPtr;
  379.       ClearWindow(wP);
  380.     END;
  381.   END OpenNewWindow;
  382.   
  383.   PROCEDURE CloseNewWindow(wP:WindowPtr);
  384.   BEGIN
  385.     Assert(wP#NIL,ADR('StringInOut:Cannot Close Window'));
  386.     DEALLOCATE(wP^.userData,SIZE(WindowDates));
  387.     DEALLOCATE(wP^.title,SIZE(WindowTitle));
  388.     CloseWindow(wP);
  389.   END CloseNewWindow;
  390.   
  391. BEGIN
  392.   CharSize(charWidth,charHeight);
  393. END StringInOut.mod
  394.